HPAVC/HPAVC CD-ROM.iso/pc/BUTTEST.ZIP/BUTTON3.PAS

Pascal/Delphi Source File | 1992-01-31 | 12.0 KB | 438 lines

                   {BUTTON3.PAS creates BUTTON3.TPU Unit}
     {From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"}

Unit Button3;

            {=============================================}
            {This version of the unit uses virtual methods}
            {=============================================}

Interface

Type
    STR40 = string[40];

    Point = object
          X,Y,Color : integer;
          Constructor Init;
          Procedure Move(Ptx,Pty : integer);
          Procedure Draw; virtual;
          Procedure Create(Ptx,Pty,C : integer);
          Procedure SetColor(C : integer);
          Procedure SetLoc(Ptx,Pty : integer); virtual;
          Procedure Erase; virtual;
          Function GetColor : integer;
          Function GetX : integer;
          Function GetY : integer;
          end; {object}

    ButtonType = (Rounded,Square,ThreeD);

    Button = object(Point)
           Exist,State,Rotate : boolean;
           FontSize,TypeFace,SizeX,SizeY : integer;
           Style : ButtonType;
           BtnTxt : STR40;
           Constructor Init;
           Procedure Draw; virtual;
           Procedure Create(Ptx,Pty,Width,Height,C : integer; Text : STR40);
           Procedure Erase; virtual;
           Procedure Invert;
           Procedure Move(Ptx,Pty : integer);
           Procedure SetColor(C : integer);
           Procedure SetState(Bstate : boolean);
           Procedure SetLabel(Text : STR40);
           Procedure SetButtonType(WhatType : ButtonType);
           Procedure SetTypeSize(TxtSize : integer);
           Procedure SetTypeFace(TxtFont : integer);
           Function GetWidth : integer;
           Function GetHeight : integer;
           Function GetState  : boolean;
           Function GetTextSize : integer;
           Function GetType : ButtonType;
           Function ButtonHit(MouseX,MouseY : integer) : boolean;
           end; {object}

{=========================================================================}

Implementation

Uses
    Crt,Graph;

Type
    RectOutline = array[1..5] of PointType;

                {========================================}
                {Local procedure used by Button functions}
                {========================================}

Procedure SetOutline(var RectArr : RectOutline; X1,Y1,X2,Y2 : integer);
Begin
     RectArr[1].x := X1;
     RectArr[1].y := Y1;
     RectArr[2].x := X1;
     RectArr[2].y := Y2;
     RectArr[3].x := X2;
     RectArr[3].y := Y2;
     RectArr[4].x := X2;
     RectArr[4].y := Y1;
     RectArr[5].x := X1;
     RectArr[5].y := Y1;
End;

{*************************************************************************}
                 {====================================}
                 {Implementation for object type Point}
                 {====================================}

Constructor Point.Init;
Begin
End;

{*************************************************************************}

Procedure Point.SetLoc;
Begin
     X := Ptx;
     Y := Pty;
End;

{*************************************************************************}

Procedure Point.Draw;
Begin
     PutPixel(X,Y,Color);
End;

{*************************************************************************}

Procedure Point.Create;
Begin
     SetLoc(Ptx,Pty);
     Color := C;
     Draw;
End;

{*************************************************************************}

Procedure Point.Erase;
Var
   Temp : integer;
Begin
     Temp := Color;
     Color := GetBkColor;
     Draw;
     Color := Temp;
End;

{*************************************************************************}

Procedure Point.Move;
Begin
     Erase;
     SetLoc(Ptx,Pty);
     Draw;
End;

{*************************************************************************}

Procedure Point.SetColor;
Begin
     Color := C;
     Draw;
End;

{*************************************************************************}

Function Point.GetColor;
Begin
     GetColor := Color;
End;

{*************************************************************************}

Function Point.GetX;
Begin
     GetX := X;
End;

{*************************************************************************}

Function Point.GetY;
Begin
     GetY := Y;
End;

{*************************************************************************}
               {=====================================}
               {Implementation for object type Button}
               {=====================================}

Constructor Button.Init;
Begin
     Exist := False;
     SetTypeSize(10);
     SetTypeFace(TriplexFont);
End;

{*************************************************************************}

Procedure Button.Draw;
Const
     Radius = 6;        {Radius of corners on rounded buttons}
     Offset = 3;        {Offset for fill                     }
Var
   RectArr : RectOutline;
   AlignX,AlignY,TempSize,TextLen,I,BtnWd,BtnHt,TextDir : integer;
Begin
     SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
     Graph.SetColor(Color);
     Case Style of
          Square  : begin
                         Graph.Rectangle(0,0,SizeX,SizeY);
                         BtnWd := SizeX - 10;
                         BtnHt := SizeY - 10;
                    end;
          ThreeD  : begin
                         Graph.Rectangle(0,0,SizeX,SizeY);
                         SetOutline(RectArr,1,1,SizeX-1,SizeY-1);
                         SetFillStyle(CloseDotFill,Color);
                         SetLineStyle(UserBitLn,0,NormWidth);
                         FillPoly(SizeOf(RectArr) div
                                  SizeOf(PointType), RectArr);
                         SetLineStyle(SolidLn,0,NormWidth);
                         Graph.Rectangle(2*Radius,2*Radius,
                                         SizeX-2*Radius,SizeY-2*Radius);
                         Line(0,0,2*Radius,2*Radius);
                         Line(0,SizeY,2*Radius,SizeY-2*Radius);
                         Line(SizeX,0,SizeX-2*Radius,2*Radius);
                         Line(SizeX,SizeY,SizeX-2*Radius,SizeY-2*Radius);
                         BtnWd := SizeX-4*Radius;
                         BtnHt := SizeY-4*Radius;
                    end
          else
                    begin
                         Style := Rounded;
                         Graph.Arc(SizeX-Radius,Radius,0,90,Radius);
                         Graph.Arc(Radius,Radius,90,180,Radius);
                         Graph.Arc(Radius,SizeY-Radius,180,270,Radius);
                         Graph.Arc(SizeX-Radius,SizeY-Radius,270,360,Radius);
                         Graph.Line(Radius,0,SizeX-Radius,0);
                         Graph.Line(Radius,SizeY,SizeX-Radius,SizeY);
                         Graph.Line(0,Radius,0,SizeY-Radius);
                         Graph.Line(SizeX,Radius,SizeX,SizeY-Radius);
                         BtnWd := SizeX-2*Radius;
                         BtnHt := SizeY-2*Radius;
                    end;
     end; {of case}

     Case Style of
          Square,
          Rounded : SetOutline(RectArr,Offset,Offset,
                               SizeX-Offset,SizeY-Offset);
          ThreeD  : SetOutline(RectArr,2*Radius+1,2*Radius+1,
                               SizeX-2*Radius-1,SizeY-2*Radius);
     end; {of case{
                              {SHOW STATE}
     if State then
        SetFillStyle(SolidFill,Color)
     else
         SetFillStyle(WideDotFill,Color);
     SetLineStyle(UserBitLn,0,NormWidth);
     FillPoly(SizeOf(RectArr) div SizeOf(PointType),RectArr);
     SetLineStyle(SolidLn,0,NormWidth);

                     {ADJUST FONTS AND STRING TO FIT}
     TempSize := FontSize;
     TextDir  := HorizDir;
     if Rotate then
     begin
          TextDir := VertDir;
          TextLen := BtnWd;
          BtnWd   := BtnHt;
          BtnHt   := TextLen;
     end;
     SetTextStyle(TypeFace,TextDir,TempSize);
     for I := FontSize downto 1 do
         if (TextWidth(BtnTxt) > BtnWd) then
            SetTextStyle(TypeFace,TextDir,I)
         else
         if (TextHeight(BtnTxt) > BtnHt) then
            SetTextStyle(TypeFace,TextDir,I);
     TextLen := Ord(BtnTxt[0]);
     while (TextWidth(Copy(BtnTxt,1,TextLen)) > BtnWd) do
           Dec(TextLen);
     AlignX := SizeX div 2 - 3;
     AlignY := SizeY div 2 - 3;   {Fine tune text position}
     if BtnTxt[TextLen] = ' ' then
        Dec(TextLen);
     if State then
        Graph.SetColor(GetBkColor);

                            {ADD LABEL}
     OutTextXY(AlignX,AlignY,Copy(BtnTxt,1,TextLen));
     if State then
        Graph.SetColor(Color);
     SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
End;

{*************************************************************************}

Procedure Button.Create;
Begin
     SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
     SetTextJustify(CenterText,CenterText);
     SetLoc(Ptx,Pty);
     if Width < 20 then
        SizeX := 20
     else
         SizeX := Width;
     if Height < 20 then
        SizeY := 20
     else
         SizeY := Height;
     if (SizeY > SizeX) then
        Rotate := True
     else
         Rotate := False;
     Color := C;
     State := False;
     Exist := True;
     BtnTxt := Text;
     Draw;
End;

{*************************************************************************}

Procedure Button.Erase;
Var
   OldColor : integer;
Begin
     if Exist then
     begin
          SetViewPort(X,Y,X+SizeX,Y+SizeY,ClipOn);
          ClearViewPort;
          Exist := False;
     end;
End;

{*************************************************************************}

Procedure Button.Move;
Begin
     Erase;
     SetLoc(Ptx,Pty);
     Draw;
End;

{*************************************************************************}

Procedure Button.SetLabel;
Begin
     BtnTxt := Text;
     Draw;
End;

{*************************************************************************}

Procedure Button.SetColor;
Begin
     Color := C;
     Draw;
End;

{*************************************************************************}

Procedure Button.SetState;
Begin
     if (State <> BState) then
        Invert;
End;

{*************************************************************************}

Procedure Button.SetTypeSize;
Begin
     FontSize := TxtSize;
End;

{*************************************************************************}

Procedure Button.SetTypeFace;
Begin
     TypeFace := TxtFont;
End;

{*************************************************************************}

Procedure Button.SetButtonType;
Begin
     Style := WhatType;
End;

{*************************************************************************}

Procedure Button.Invert;
Begin
     State := not State;
     Draw;
End;

{*************************************************************************}

Function Button.GetWidth;
Begin
     GetWidth := SizeX;
End;

{*************************************************************************}

Function Button.GetHeight;
Begin
     GetHeight := SizeY;
End;

{*************************************************************************}

Function Button.GetState;
Begin
     GetState := State;
End;

{*************************************************************************}

Function Button.GetTextSize;
Begin
     GetTextSize := FontSize;
End;

{*************************************************************************}

Function Button.GetType;
Begin
     GetType := Style;
End;

{*************************************************************************}

Function Button.ButtonHit;
Var
   Result : boolean;
Begin
     Result := False;
     if (MouseX >= X) and (MouseX <= X+SizeX) and
        (MouseY >= Y) and (MouseY <= Y+SizeY) then
                Result := True;
     if Result then
        Invert;
     ButtonHit := Result;
End;

{*************************************************************************}


BEGIN
     {No initialization required}
END.